home *** CD-ROM | disk | FTP | other *** search
/ NeXT Education Software Sampler 1992 Fall / NeXT Education Software Sampler 1992 Fall.iso / Programming / Source / winterp-1.13 / examples / xlisp-2.1 / pt.lsp < prev    next >
Encoding:
Lisp/Scheme  |  1991-10-06  |  4.2 KB  |  143 lines
  1. ; -*-Lisp-*-
  2. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3. ;
  4. ; File:         pt.lsp
  5. ; RCS:          $Header: $
  6. ; Description:  This is a sample XLISP program. It implements a simple form of
  7. ;        programmable turtle It only works on the Macintosh version of
  8. ;        XLISP at the moment.
  9. ;        To run it:
  10. ;            (load "pt.lsp")
  11. ;        This should cause the screen to be cleared and two turtles to appear.
  12. ;        They should each execute their simple programs and then the prompt
  13. ;        should return.  Look at the code to see how all of this works.
  14. ; Author:       ???
  15. ; Created:      Sat Oct  5 21:11:06 1991
  16. ; Modified:     Sat Oct  5 21:12:23 1991 (Niels Mayer) mayer@hplnpm
  17. ; Language:     Lisp
  18. ; Package:      N/A
  19. ; Status:       X11r5 contrib tape release
  20. ;
  21. ; WINTERP Copyright 1989, 1990, 1991 Hewlett-Packard Company (by Niels Mayer).
  22. ; XLISP version 2.1, Copyright (c) 1989, by David Betz.
  23. ;
  24. ; Permission to use, copy, modify, distribute, and sell this software and its
  25. ; documentation for any purpose is hereby granted without fee, provided that
  26. ; the above copyright notice appear in all copies and that both that
  27. ; copyright notice and this permission notice appear in supporting
  28. ; documentation, and that the name of Hewlett-Packard and Niels Mayer not be
  29. ; used in advertising or publicity pertaining to distribution of the software
  30. ; without specific, written prior permission.  Hewlett-Packard and Niels Mayer
  31. ; makes no representations about the suitability of this software for any
  32. ; purpose.  It is provided "as is" without express or implied warranty.
  33. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  34.  
  35. ; Get some more memory
  36. (expand 1)
  37.  
  38. ; ::::::::::::
  39. ; :: Turtle ::
  40. ; ::::::::::::
  41.  
  42. ; Define "Turtle" class
  43. (setq Turtle (send Class :new '(xpos ypos)))
  44.  
  45. ; Answer ":isnew" by initing a position and char and displaying.
  46. (send Turtle :answer :isnew '(x y) '(
  47.     (setq xpos x)
  48.     (setq ypos y)
  49.     (send self :display)
  50.     self))
  51.  
  52. ; Message ":display" prints its char at its current position
  53. (send Turtle :answer :display '() '(
  54.     (moveto xpos ypos)
  55.     (lineto xpos ypos)
  56.     self))
  57.  
  58. ; Message ":goto" goes to a new place after clearing old one
  59. (send Turtle :answer :goto '(x y) '(
  60.     (moveto xpos ypos)
  61.     (setq xpos x)
  62.     (setq ypos y)
  63.     (lineto xpos ypos)
  64.     self))
  65.  
  66. ; Message ":up" moves up
  67. (send Turtle :answer :up '() '(
  68.     (send self :goto xpos (- ypos 10))))
  69.  
  70. ; Message ":down" moves down
  71. (send Turtle :answer :down '() '(
  72.     (send self :goto xpos (+ ypos 10))))
  73.  
  74. ; Message ":right" moves right
  75. (send Turtle :answer :right '() '(
  76.     (send self :goto (+ xpos 10) ypos)))
  77.  
  78. ; Message ":left" moves left
  79. (send Turtle :answer :left '() '(
  80.     (send self :goto (- xpos 10) ypos)))
  81.  
  82.  
  83. ; :::::::::::::
  84. ; :: PTurtle ::
  85. ; :::::::::::::
  86.  
  87. ; Define "DPurtle" programable turtle class
  88. (setq PTurtle (send Class :new '(prog pc) '() Turtle))
  89.  
  90. ; Message ":program" stores a program
  91. (send PTurtle :answer :program '(p) '(
  92.     (setq prog p)
  93.     (setq pc prog)
  94.     self))
  95.  
  96. ; Message ":step" executes a single program step
  97. (send PTurtle :answer :step '() '(
  98.     (if (null pc)
  99.     (setq pc prog))
  100.     (if pc
  101.     (progn (send self (car pc))
  102.            (setq pc (cdr pc))))
  103.     self))
  104.  
  105. ; Message ":step:" steps each turtle program n times
  106. (send PTurtle :answer :step: '(n) '(
  107.     (dotimes (x n) (send self :step))
  108.     self))
  109.  
  110.  
  111. ; ::::::::::::::
  112. ; :: PTurtles ::
  113. ; ::::::::::::::
  114.  
  115. ; Define "PTurtles" class
  116. (setq PTurtles (send Class :new '(turtles)))
  117.  
  118. ; Message ":make" makes a programable turtle and adds it to the collection
  119. (send PTurtles :answer :make '(x y &aux newturtle) '(
  120.     (setq newturtle (send PTurtle :new x y))
  121.     (setq turtles (cons newturtle turtles))
  122.     newturtle))
  123.  
  124. ; Message ":step" steps each turtle program once
  125. (send PTurtles :answer :step '() '(
  126.     (mapcar #'(lambda (turtle) (send turtle :step)) turtles)
  127.     self))
  128.  
  129. ; Message ":step:" steps each turtle program n times
  130. (send PTurtles :answer :step: '(n) '(
  131.     (dotimes (x n) (send self :step))
  132.     self))
  133.  
  134.  
  135. ; Create some programmable turtles
  136. (setq turtles (send PTurtles :new))
  137. (setq t1 (send turtles :make 200 100))
  138. (setq t2 (send turtles :make 210 100))
  139. (send t1 :program '(:left :left :up :right :up))
  140. (send t2 :program '(:right :right :down :left :down))
  141. (show-graphics)
  142. (send turtles :step: 20)
  143.